Background given in the case desciprtion: “The course lasts twelve weeks. Throughout the course, students are assessed in multiple ways, including weekly quizzes, slide exams, and essays. They also take an end of course exam that includes essay, short answer, and multiple-choice components. The final data has the average scores for those assessments. Students are required to take laboratory practical (gross anatomy, histology, pathology and neuroanatomy) exams which are averaged into the final grade. Students also take a National Board of Medical Examiners (NBME) standardized exam in each course. Theoretically, if they do well on these exams, they should do well in the course overall. All of the assessments have been calculated on a 100- point scale.”
1.1 Questions from Learning Objective 4
How should we define not pass/ marginal pass/ pass thresholds and criteria?
How do these thresholds compare to final exam scores
1.2 Data
There are 92 students.
Code
label(dt$quiz) <-"Quiz score (mean weekly performance)"label(dt$nbme) <-"National Board of Medical Examiners score"label(dt$ga) <-"GA"label(dt$slide) <-"Slide exams score (mean)"label(dt$part.c) <-"Part C score"label(dt$essay) <-"Essay score (mean)"label(dt$eob.exam) <-"EOB exam"label(dt$final) <-"Final score"table1(~quiz + nbme + ga + slide + part.c + essay+ eob.exam + final , data=dt, topclass="Rtable1-zebra",)
Overall (N=92)
Quiz score (mean weekly performance)
Mean (SD)
0.821 (0.0685)
Median [Min, Max]
0.820 [0.660, 1.00]
National Board of Medical Examiners score
Mean (SD)
89.9 (5.45)
Median [Min, Max]
91.0 [74.0, 100]
GA
Mean (SD)
83.0 (9.89)
Median [Min, Max]
83.9 [49.5, 100]
Slide exams score (mean)
Mean (SD)
82.3 (10.0)
Median [Min, Max]
83.9 [53.1, 100]
Part C score
Mean (SD)
81.1 (8.70)
Median [Min, Max]
81.6 [59.6, 100]
Essay score (mean)
Mean (SD)
86.8 (5.42)
Median [Min, Max]
87.3 [71.3, 95.8]
EOB exam
Mean (SD)
84.9 (6.83)
Median [Min, Max]
85.0 [65.0, 99.0]
Final score
Mean (SD)
88.5 (5.63)
Median [Min, Max]
88.5 [68.0, 100]
Code
length(unique(dt$id))
[1] 92
Questions for Mario:
What does GA stand for in the data? What does part.c stand for in the data? What does eob refer to on the exam? Where is the score for the laboratory practical?
---title: "Case 1 Learning Objective 4"author: "Lisa Levoir and Jeffrey Zhuohui Liang"date: "`r format(Sys.time(), '%B %d, %Y')`"format: html: theme: yeti code-fold: true code-tools: true html-math-method: katex toc: true toc-depth: 3 fig-width: 13 fig-height: 10 toc-title: "Contents" number-sections: true self-contained: true self-contained-math: true smooth-scroll: true fontsize: 0.8em title-block-banner: true citation-location: margineditor: visual---```{r setup}#| echo: false#| message: false#| warning: false#| include: false#load libraries (more than I need but nice ot have)library(tidyverse)library(knitr)library(table1) #Create HTML Tables of Descriptive Statistics https://cran.r-project.org/web/packages/table1/vignettes/table1-examples.html#library(OMTM1) #https://github.com/schildjs/OMTM1/library(Hmisc)library(viridis) #colorslibrary(tidyverse)library(readxl)library(corrplot)library(arsenal)library(GGally)library(ggthemes)library(ggfortify)library(plotly)library(dplyr)library(tidyr)library(cowplot) #allows me to use plotgridtheme_set(ggthemes::theme_calc())scale_color_discrete =scale_color_calc()setwd("/Users/lisalevoir/BIOS7351_Collab/github/BIOS_Collaboration") #this line used to work until I moved this qmd file to my github folder (I need to run this in the console when I switch projects)knitr::opts_knit$set(root.dir ="/Users/lisalevoir/BIOS7351_Collab/github/BIOS_Collaboration/case1") #this is a global option for knittingdt <- readxl::read_xlsx("~/BIOS7351_Collab/github/BIOS_Collaboration/case1/Case1.xlsx")```# Analyzing medical students scoresBackground given in the case desciprtion: "The course lasts twelve weeks. Throughout the course, students are assessed in multiple ways, including weekly quizzes, slide exams, and essays. They also take an end of course exam that includes essay, short answer, and multiple-choice components. The final data has the average scores for those assessments. Students are required to take laboratory practical (gross anatomy, histology, pathology and neuroanatomy) exams which are averaged into the final grade. Students also take a National Board of Medical Examiners (NBME) standardized exam in each course. Theoretically, if they do well on these exams, they should do well in the course overall. All of the assessments have been calculated on a 100- point scale."## Questions from Learning Objective 4- How should we define not pass/ marginal pass/ pass thresholds and criteria?- How do these thresholds compare to final exam scores## DataThere are `r length(unique(dt$id))` students.```{r}label(dt$quiz) <-"Quiz score (mean weekly performance)"label(dt$nbme) <-"National Board of Medical Examiners score"label(dt$ga) <-"GA"label(dt$slide) <-"Slide exams score (mean)"label(dt$part.c) <-"Part C score"label(dt$essay) <-"Essay score (mean)"label(dt$eob.exam) <-"EOB exam"label(dt$final) <-"Final score"table1(~quiz + nbme + ga + slide + part.c + essay+ eob.exam + final , data=dt, topclass="Rtable1-zebra",)length(unique(dt$id))```Questions for Mario:- What does GA stand for in the data? What does part.c stand for in the data? What does eob refer to on the exam? Where is the score for the laboratory practical?- Can we assume the slide exam score is a mean?```{r}dt = dt %>%mutate(quiz =100*quiz)tableby(pass~.,dt %>%select(-id) %>%mutate(pass = final>70),control =tableby.control(numeric.stats =c("meansd","median","range"), )) %>%summary() %>% knitr::kable()set.seed(123123)pc =prcomp(dt %>%select(-id,-final) %>%mutate_all(scale))``````{r}#| fig-width: 10#| fig-height: 10ggpairs(dt %>%select(-id),aes(color=ifelse(final>80,"pass","(almost)fail")),progress = F)``````{r}cl =kmeans(dt %>%select(-id) %>%mutate_all(scale),centers =4)$clusterdt %>%left_join(tibble(id = dt$id,cluster =as.factor(cl))) %>%cbind(pc$x) %>%ggplot(aes(x=PC1,y=final,color=cluster)) +scale_color_calc()+geom_jitter()autoplot(pc,color =as.factor(cl))```## Can I create a better metric?```{r}#| fig-width: 10#| fig-height: 10overall =0.6*rowMeans(dt %>%select(-id,-final,-nbme)) +0.4*dt$nbmedt %>%select(-id) %>%mutate(overall = overall) %>%ggpairs(.,aes(color =ifelse( overall>quantile(overall,0.05),"pass","fail")),progress = F)dt %>%mutate(overall = overall,pass = overall>quantile(overall,0.05)) %>%cbind(pc$x) %>%ggplot(aes(y=PC2,x=PC1,color=pass))+geom_jitter()``````{r}#| fig-width: 10#| fig-height: 10overall =scale(pc$x)[,1:2] %*%c(-0.8,0.2) dt %>%select(-id) %>%mutate(overall =as.numeric(overall)) %>%ggpairs(.,aes(color =ifelse( overall>quantile(overall,0.05),"pass","fail")),progress = F)dt %>%mutate(overall = overall,pass = overall>quantile(overall,0.05)) %>%cbind(pc$x) %>%ggplot(aes(x=PC1,y=PC2,color=pass))+geom_jitter()```